Shareware Grab Bag/Shareware Grab Bag.iso/007/simcode.arc/VENTEL.PAS

Pascal/Delphi Source File | 1985-01-19 | 14.0 KB | 618 lines

{$symtab-,$linesize:131,$pagesize:86,$debug-,
$title:'VENTEL.PAS -- Controller for the VENTEL Auto-Dialer'}
{    COPYRIGHT @ 1982
    Jim Holtman and Eric Holtman
    35 Dogwood Trail
    Randolph, NJ 07869
    [phone]
}

{$mathck-}
 module ventel_or_hayes;
{$include:'graph.inc'}
{$include:'comm.inc'}
{$include:'simterm.inc'}
{$include:'util.inc'}

    type
       menu_c = super array [1..*] of lstring(40);
       board_data = record
      last_state,successful_calls : integer;
      comment : ^lstring;
      tel_numbers : lstring(20);
      end;

    const
       MAX_NUMBERS = 700;

    var
       [ external] telfile : text ;
       bbs_numbers : boolean ;
       max_bbs : integer ;
       last_bbs : integer ;
       char_graphics : boolean;
       parity_mask : integer;
       hayes_modem : boolean;

    var
       used_numbers : integer;
       c_state : array[0..10] of char;
       cancel_command [public] : boolean;
       boards : array[0..MAX_NUMBERS] of ^board_data;
       bbs_filename [public] : lstring(64);

    const
       NOT_CALLED = 0;
       BUSY = 1;
       NO_ANSWER = 2;
       DEAD_PHONE = 3;
       SUCCESS = 4;
       REMOVE = 5;

value
       c_state[NOT_CALLED] := '?';
       c_state[BUSY] := 'B';
       c_state[NO_ANSWER] := 'N';
       c_state[DEAD_PHONE] := 'D';
       c_state[SUCCESS] := 'S';
       c_state[REMOVE] := 'R';
       used_numbers := 0;
       bbs_filename := '\simterm\boards';

    function menuit(var choices : menu_c;
     const title : lstring ) : integer;

       external;

    function getc(exit_flag : LOOP_FLAG) : integer;

       external;

    procedure ck(a : integer;
     const b : string);

       external;

    procedure savescreen;

       external;

    procedure restorescreen;

       external;

    function do_cancel : boolean [public];

       var
      ch : char;

       begin
      if (cancel_command = false) then
         if (xxinkey(ch) > 0) then cancel_command := true    ;
      do_cancel := cancel_command;
      end;

    procedure dial(var number : lstring) [public];
                   {dial number on a ventel autodialer}

       var
      ch : integer;

       procedure slow_send(const str : lstring);

      var
         i : word;

      begin
         for i:=1 to str.len do begin
        send(str[i]);
        send(chr(0)*chr(0)*chr(0));
        end;
         end;

       begin
      writeln;
      writeln;
      writeln('Dialing...  ', number);
      toggle_tr;
      sleep(2);
      if (hayes_modem = false) then begin
         send(chr(13));
                   {output character}
         sleep(1);
         send(chr(13));
                   {output character}
         sleep(1);
         slow_send('k');
         sleep(2);
         slow_send(number);
         send(chr(13));
         end
      else begin
         send('ATDT');    {output character}
         send(number);
         send(chr(13));
         end;
      end;

    procedure do_success;

       var
      inch : char;

       begin
      writeln;
      writeln('Success!!! (hit any key to terminate alarm)');
      repeat
         write(chr(7));
         sleep(1);
         until xxinkey(inch) > 0;
      end;

    procedure eat_up_output;

       var
      ch : integer;
      wait_time : word;

       begin
      wait_time := timer;
      repeat
         ch := getc(EXIT);
         until (ch = 13) or ((timer-wait_time) > 3);
      end;

    function is_answered(num : integer) : boolean [public];

       var
      ch : integer;
      inch : char;
      wait_time : word;

       begin
      write('Waiting for modem to start dialing...');
      wait_time := timer;
      repeat
         if (timer-wait_time) > 30 then ch := ord('G')
         else ch := getc(EXIT);
         if do_cancel then begin
        is_answered := false;
        boards[num]^.last_state := DEAD_PHONE;
        return;
        end;
         until ch > -1;
      if (hayes_modem = false) then begin
         while (ch <> ord('G')) do begin
        repeat
           ch := getc(EXIT);
           until ((ch > -1) or do_cancel);
        if do_cancel then begin
           is_answered := false;
           boards[num]^.last_state := DEAD_PHONE;
           return;
           end;
        end;
         end
      else eat_up_output;
      write('Waiting for answer...');
      wait_time := timer;
      while true do begin
         with boards[num]^ do begin
        case ord(ch) of
           ord('O'),ord('C'): begin
              is_answered := true;
              do_success;
              eat_up_output;
              last_state := SUCCESS;
              successful_calls := successful_calls + 1;
              return;
              end;
           ord('B'): begin
              is_answered := false;
              writeln('Busy');
              eat_up_output;
              last_state := BUSY;
              return;
              end;
           ord('D'): begin
              is_answered := false;
              writeln('Dead phone');
              eat_up_output;
              last_state := DEAD_PHONE;
              return;
              end;
           ord('N'): begin
              is_answered := false;
              writeln('No answer');
              eat_up_output;
              last_state := NO_ANSWER;
              return;
              end;
           otherwise ;
           end;
        end;

         repeat
        if (timer-wait_time) > 30 then ch := ord('B')
        else ch := getc(EXIT);
        if do_cancel then begin
           is_answered := false;
           boards[num]^.last_state := DEAD_PHONE;
           return;
           end;
        until ch > -1;
         end;
      writeln('Failed');
      is_answered := false;
      boards[num]^.last_state := DEAD_PHONE;
      end;

    procedure parse_file(var infile : lstring);

       external;

    procedure ltrm(var s : lstring);

       var
      i : integer;

       begin
      while (s[1] in [chr(32), chr(9)]) and (s.len > 0) do begin
         delete(s,1,1);
         end;
      end;

    procedure rtrm(var s : lstring);

       var
      i : integer;

       begin
      while (s[ord(s.len)] in [chr(32), chr(9)]) and (s.len > 0) do begin
         s.len := s.len - 1;
         end;
      end;

    procedure write_file [public];

       var
      i : integer;
      filename : lstring(64);

       begin
      if (bbs_numbers = false) then return;
      filename := bbs_filename;
      parse_file(filename);
      assign(telfile, filename);
      rewrite(telfile);
      for i := 0 to max_bbs -1 do begin
         with boards[i]^ do begin
        if (last_state = REMOVE) then begin
           if (comment <> nil) then dispose(comment);
           dispose(boards[i]);
           boards[i] := nil;
           cycle;
           end;
        ltrm(tel_numbers);
        write(telfile, last_state, successful_calls,' ', tel_numbers);
        if (comment <> nil) then begin
           writeln(telfile,'#',comment^);
           dispose(comment);
           comment := nil;
           end
        else writeln(telfile);
        end;
         dispose(boards[i]);
         boards[i] := nil;
         end;
      close(telfile);
      bbs_numbers := false;
      end;

    procedure read_file;

       var
      i : integer;
      com_start : integer;
      num_len : integer;
      fts [static] : boolean;
      buffer : lstring(128);
      filename : lstring(64);

      value fts := true;

       begin
      if (fts) then begin
         for i := 0 to MAX_NUMBERS do boards[i] := nil;
         fts := false;
         end;
      filename := bbs_filename;
      parse_file(filename);
      assign(telfile, filename);
      reset(telfile);
      i := 0;
      while ((not eof(telfile)) and (i<MAX_NUMBERS)) do begin
         new(boards[i]);
         with boards[i]^ do begin
        readln(telfile, last_state, successful_calls, buffer);
        ltrm(buffer);
        rtrm(buffer);
        num_len := ord(buffer.len);
        com_start := scaneq(num_len, '#', buffer, 1);
        comment := nil;    {initialize}
        if (com_start < num_len) then begin
           new(comment, num_len);
           copylst(buffer, comment^);
           delete(comment^, 1, com_start+1);
           delete(buffer, com_start+1, (num_len - com_start));
           end;
        copylst(buffer, tel_numbers);
        end;
         i := i + 1;
         end;
      max_bbs := i;
      close(telfile);
      last_bbs := -1;
      bbs_numbers := true;
      end;

    procedure call_next_bbs;

       var
      i : integer;

       begin
      if (bbs_numbers = false) then begin
         read_file;
         end;
      last_bbs := last_bbs + 1;
      if (last_bbs = max_bbs) then begin
         writeln('Beginning at beginning of BBS list again! ');
         last_bbs := 0;
         end;
      with boards[last_bbs]^ do begin
         dial(tel_numbers);
         eval(is_answered(last_bbs));
         end;
      end;

    procedure choose_number;

       var
      i, x,y : integer;
      resp : lstring(10);
      ch : char;

       begin
      if (bbs_numbers = false) then begin
         read_file;
         end;
      xxcls;
      for i := 0 to max_bbs -1 do begin
         if (((i mod 22) = 0) ) then begin
        if (i > 0) then begin
           xxmove(20,23);
           write('Hit return to finish listing (ESC to quit)....');
           repeat
              x := xxinkey(ch);
              until ((x = 1) and ((ch = chr(13)) or (ch = chr(27))));
           if (ch = chr(27)) then return;
           end;
        xxmove(0,0);
        xxcls;
        xxmove(6,0);
        write('Number');
        xxmove(25,0);
        write('Last state');
        xxmove(38,0);
        writeln('Comment');
        end;
         with boards[i]^ do begin
        write(i:3,') ',tel_numbers:18);
        xrcurp(x,y);
        xxmove(25,y);
        case c_state[last_state] of
           'B': write('Busy');
           'N': write('No answer');
           'D': write('Dead phone');
           'S': write('Success');
           'R': write('Removed');
           '?': write('Not tried');
           end;
        xxmove(38,y);
        if (comment <> nil) then write(comment^:-40);
        writeln;
        end;
         end;
      xxmove(20,23);
      write('Which number (<cr> to exit) ? ');
      readln(resp);
      if (decode(resp, x) = true) then begin
         if ((x> -1) and (x < max_bbs)) then begin
        xxcls;
        last_bbs := x;
        dial(boards[x]^.tel_numbers);
        eval(is_answered(x));
        end;
         end;
      end;

    procedure print_number;

       var
      i, x,y : integer;
      resp : lstring(10);
      ch : char;
      pr : text;

       begin
      if (bbs_numbers = false) then begin
         read_file;
         end;
      assign(pr, 'lpt1:');
      rewrite(pr);
      for i := 0 to max_bbs -1 do begin
         if ( (i mod 60) = 0) then begin
        if (i > 0) then
           for x := 1 to 4 do writeln(pr)   ;
        write(pr,'Number':-25);
        write(pr,'Last state':-13);
        writeln(pr,'Comment');
        writeln(pr);
        end;
         with boards[i]^ do begin
        write(pr,i:3,') ',tel_numbers:-20);
        case c_state[last_state] of
           'B': write(pr,'Busy':-13);
           'N': write(pr,'No answer':-13);
           'D': write(pr,'Dead phone':-13);
           'S': write(pr,'Success':-13);
           'R': write(pr,'Removed':-13);
           '?': write(pr,'Not tried':-13);
           end;
        if (comment <> nil) then write(pr,comment^:-40);
        writeln(pr);
        end;
         end;
      close(pr);
      end;

    procedure search_numbers;

       var
      i : integer;
      inch : char;
      uncalled : integer;

       begin
      srand;
      xxcls;
      writeln('Scanning BBS systems.......');

      if (bbs_numbers = false) then begin
         read_file;
         end;
      uncalled := 0;
      for i := 0 to max_bbs-1 do
         if (boards[i]^.last_state = NOT_CALLED) then uncalled := uncalled +
          1   ;
      i := 0;
      repeat
         xxmove(0,0);
         xxcls;
         if (uncalled = 0) then begin
        writeln('Beginning at beginning of BBS list again! ');
        for i := 0 to max_bbs -1 do begin
                   if boards[i]^.last_state <> REMOVE then begin
              boards[i]^.last_state := NOT_CALLED;
              uncalled := uncalled+1;
                 end;
           end;
        end;
         repeat
        i := rand(max_bbs) -1;
        until boards[i]^.last_state = NOT_CALLED;
         writeln('Dialing number ', i:4, ',  ',uncalled:3,' numbers remain')
          ;
         writeln('This board has been reached ', boards[i]^.
          successful_calls:3, ' times in the past');
         if (boards[i]^.comment <> nil) then writeln('Comment: ',boards[i]^.
          comment^);
         if do_cancel then begin
        toggle_tr;
        writeln('Aborted search');
        break;
        end;
         dial(boards[i]^.tel_numbers);
         last_bbs := i;
         if do_cancel then begin
        toggle_tr;
        writeln('Aborted search');
        break;
        end;
         uncalled := uncalled - 1;
         until is_answered(i);
      end;

    procedure do_ventels [public];

       var
      inch : char;
      choice : integer;
      t : word;
      menu [static] : menu_c(9);
      value menu[1] := 'Scan bbs list until a hit';
      menu[2] :='Write the bbs file';
      menu[3] := 'Dial the next Board';
      menu[4] := 'Delete the number you just dialed';
      menu[5] := 'Print and choose a number';
      menu[6]:= 'Enable character graphics';
      menu[7] := 'Comment about last board';
      menu[8] := 'Add new number';
      menu[9] := 'Generate printer listing of boards';

       begin
      cancel_command := false;
      savescreen;
      choice := menuit(menu, 'Ventel Dialing Options');
      writeln;
      case choice of
         1: begin
        search_numbers;
        parity_mask := parity_mask or #80;
        char_graphics := true;
        end;

         2:
        if (bbs_numbers = true) then write_file   ;
         3: call_next_bbs;
         4: begin
        if (last_bbs >= 0) then begin
           write('Delete ',boards[last_bbs]^.tel_numbers,
            '  Confirm(y/n)? ');
           while (xxinkey(inch) = 0) do begin
              end;
           if (inch = 'y') then begin
              boards[last_bbs]^.last_state := REMOVE;
              end;
           end;
        end;
         7: begin
        writeln;
        if (last_bbs >= 0) then begin
           with boards[last_bbs]^ do begin
              if (comment = nil) then new(comment,40);
              write('Comment for number ',tel_numbers,' - ');
              readln(comment^);
              end;
           end
        else begin
           writeln('You have not dialed a number to comment on');
           sleep(2);
           end;
        end;
         8: begin
        if (bbs_numbers = false) then read_file;
        writeln;
        writeln('You must add "9 &" to allow dialing on a ventel');
        write('New number - ');
        new(boards[max_bbs]);
        with boards[max_bbs]^ do begin
           readln(tel_numbers);
           last_state := NOT_CALLED;
           successful_calls := 0;
           comment := nil;
           max_bbs := max_bbs + 1;
           end;
        end;
         5: choose_number;
         6: begin
        parity_mask := parity_mask or #80;
        char_graphics := true;
        end;
         9: print_number;
         otherwise ;
         end;
      restorescreen;
      end;     end.